Option Explicit
Sub druck()
Dim intRow As Integer, intLastRow As Integer
Dim al As Worksheet
Dim x As Long, y As Long, lngZeilen As Long
Dim V1, V2, V3, V4
Dim appWord As Object
Dim docTest As Object
Dim txt As String
txt = "Uhr"
'Zuweisung der Tabellen zu den Variablen
With ThisWorkbook
Set al = .Worksheets("Auslieferungsliste")
End With
'hier wird die länge der Quelltabelle ermittelt und in die Zieltabelle eingefügt
lngZeilen = al.Cells(al.Rows.Count, 1).End(xlUp).Row
'Schleife die die Quelltabelle durchsucht und bei bestimmter Bedingung wird die Aktion copy-paste gestartet
Set appWord = CreateObject("Word.Application")
appWord.Visible = True
For y = 2 To lngZeilen
'Bedingungen
With al
V1 = .Cells(y, 2).Value
V2 = .Cells(y, 3).Value
V3 = .Cells(y, 4).Value
V4 = .Cells(y, 5).Text
End With
If V1 <> "" And V2 <> "" And V3 <> "" And V4 <> "" Then
Set docTest = appWord.documents.Add("C:\Dokumente und Einstellungen\P325130\Desktop\kennzeichen.doc")
docTest.Activate
docTest.Bookmarks("kennzeichen").Range.Text = V1
docTest.Bookmarks("name").Range.Text = V2
docTest.Bookmarks("datum").Range.Text = V3
docTest.Bookmarks("uhrzeit").Range.Text = V4 & " " & txt
DoEvents
docTest.PrintOut
docTest.Close SaveChanges:=False
Else
End If
Next y
Application.DisplayAlerts = False 'keine Bildschirmmeldungen
If appWord.documents.Count = 0 Then appWord.Quit
Application.DisplayAlerts = True 'wieder einschalten
Set docTest = Nothing
Set appWord = Nothing
End Sub
Warum willst du appWord jedesmal neu erstellen? Einmal vor der Schleife erstellen und danach schließen sollte reichen > weniger Fehlermeldung, schneller.
Dann vor den Befehelen Bildschirmmeldungen deaktivieren und es sollte keine Meldungen mehr geben. Würde aber immer versuchen die Meldungen ohne "Stummschalten" zu umgehen. Wenn jetzt noch Meldungen auftauchen, kann man die auch ausschalten, würde aber erstmal gucken, ob dein Makro trotz Meldungen so ausgeführt wird wie es soll...
Gruß
Till
|